{-# LANGUAGE TemplateHaskell #-}

module Vote.TH.Enum where

import Control.Lens (makeLenses)
import qualified Data.Aeson as A
import Data.Aeson.TH (defaultOptions, deriveJSON)
import Data.OpenApi (fromAesonOptions)
import qualified Data.OpenApi as O
import Data.OpenApi.Internal.Schema (ToSchema (..), genericDeclareNamedSchema)
import Data.Tuple.Extra (fst3, uncurry3)
import Database.Persist.TH (derivePersistField)
import Language.Haskell.TH
import Protolude
import Text.Casing (camel)
import Vote.Internal.Util (trimPrefixName, trimPrefixName_, upperFirst)
import Prelude (String)

--

data SelectItem = SelectItem
  { _selectItemId :: String,
    _selectItemTitle :: String,
    _selectItemDesc :: String
  }
  deriving (Show, Eq, Generic)

deriveJSON (defaultOptions {A.fieldLabelModifier = trimPrefixName_ ''SelectItem}) ''SelectItem

instance ToSchema SelectItem where
  declareNamedSchema = genericDeclareNamedSchema ((fromAesonOptions defaultOptions) {O.fieldLabelModifier = trimPrefixName_ ''SelectItem})

makeLenses ''SelectItem

class Selectable a where
  selectItems :: Proxy a -> [SelectItem]

--

data Enumerable = Enumerable String [(String, String, String)] deriving (Show, Eq)

--

makeEnum :: Enumerable -> Q [Dec]
makeEnum (Enumerable name pairs) = do
  let tName = mkName name
  let cons = pairs <&> ((`NormalC` []) . mkName . (name <>) . upperFirst . camel . fst3)
  let decEnum =
        DataD
          []
          tName
          []
          Nothing
          cons
          [DerivClause Nothing [ConT ''Show, ConT ''Read, ConT ''Eq, ConT ''Ord, ConT ''Enum, ConT ''Generic]]
  return $ pure decEnum

makeEnumIns :: Enumerable -> Q [Dec]
makeEnumIns (Enumerable name tuples) = do
  let tName = mkName name
  decJSON <- deriveJSON defaultOptions {A.constructorTagModifier = trimPrefixName tName} tName
  decPersistField <- derivePersistField name
  decSelectable <- do
    e <- [|tuples <&> uncurry3 SelectItem|]
    return $ InstanceD Nothing [] (AppT (ConT ''Selectable) (ConT tName)) [FunD 'selectItems [Clause [WildP] (NormalB e) []]]
  decToSchema <- do
    e <- [|genericDeclareNamedSchema ((fromAesonOptions defaultOptions) {O.constructorTagModifier = trimPrefixName (mkName name)})|]
    return $ InstanceD Nothing [] (AppT (ConT ''ToSchema) (ConT tName)) [FunD 'declareNamedSchema [Clause [] (NormalB e) []]]
  return $ decJSON <> decPersistField <> pure decSelectable <> pure decToSchema
